import Graphics.UI.SDL as SDL

data GameContext = GameContext { getSurface :: Surface,
                                 getScreenWidth :: Int,
                                 getScreenHeight :: Int
                               }
life_body_board_width = 40 :: Int
_init_life_body = [[0 | 
                   i <- [1..life_body_board_width]] | 
                   j <- [1..life_body_board_width]]
                 
init_life_body = [[0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0],
                  [0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0],
                  [0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0],
                  [0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0],
                  [0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0],
                  [0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,0,0,0,0,0,1,1,0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,0],
                  [0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,1,0,0,0,0,1,1,0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,0],
                  [0,0,1,1,0,0,0,0,0,0,0,0,1,0,0,0,0,0,1,0,0,0,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0],
                  [0,0,1,1,0,0,0,0,0,0,0,0,1,0,0,0,1,0,1,1,0,0,0,0,1,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0],
                  [0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,1,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0],
                  [0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0],
                  [0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0],
                  [0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0],
                  [0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0],
                  [0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0],
                  [0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0],
                  [0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0],
                  [0,0,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0],
                  [0,0,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0],
                  [0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0],
                  [0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0],
                  [0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0],
                  [0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0],
                  [0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0],
                  [0,0,0,0,0,0,0,1,1,0,0,0,0,0,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0],
                  [0,0,0,0,0,0,1,0,0,0,1,0,0,0,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0],
                  [0,1,1,0,0,1,0,0,0,0,0,1,0,0,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0],
                  [0,1,1,0,0,1,0,0,0,1,0,1,1,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0],
                  [0,0,0,0,0,1,0,0,0,0,0,1,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0],
                  [0,0,0,0,0,0,1,0,0,0,1,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0],
                  [0,0,0,1,1,1,0,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0],
                  [0,0,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0],
                  [0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0],
                  [0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0],
                  [0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0],
                  [0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0],
                  [0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0],
                  [0,0,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0],
                  [0,0,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0],
                  [0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0]]
                                    

print_life_body []     = do 
  putStrLn "======================================="
  return ()

print_life_body (x:xs) = do
  print_life_line x
  print_life_body xs
  where 
    print_life_line []     = do
      putChar '\n'
      return ()
    print_life_line (x:xs) = do
      putChar (if x == 1 then '@' else '-')
      print_life_line xs

update_life_body life_body = 
  [update_life_cell_line life_body i | i <- [0..life_body_board_width-1]]
  where
    update_life_cell_line life_body i
      | i == 0 || i == life_body_board_width-1 = 
        [0 | _ <- [0..life_body_board_width-1]]
      | otherwise = 
          [update_life_cell life_body i j | j <- [0..life_body_board_width-1]]
        
    update_life_cell life_body i j 
      | j == 0 || j == life_body_board_width-1 = 0
      | otherwise =
        let s = life_body !! (i-1) !! (j-1) +
                life_body !! (i-1) !! j +
                life_body !! (i-1) !! (j+1) +
                life_body !! i !! (j-1) +
                life_body !! i !! (j+1) +
                life_body !! (i+1) !! (j-1) +
                life_body !! (i+1) !! j +                
                life_body !! (i+1) !! (j+1) 
        in 
         case s of
           2 -> life_body !! i !! j
           3 -> 1
           _ -> 0
           
draw_game_board life_body game_context = do
  let screen = getSurface game_context
      
      dummy = [draw_cell life_body game_context i j | 
               i <- [0..life_body_board_width-1],
               j <- [0..life_body_board_width-1]]

  draw_cells life_body game_context 0 0
  SDL.flip screen
  
  where 
    draw_cells life_body game_context i j = do
      if i < life_body_board_width
        then do draw_cellsY life_body game_context i j
                draw_cells life_body game_context (i+1) j
        else return ()
             
    draw_cellsY life_body game_context i j = do
      if j < life_body_board_width
        then do draw_cellsY life_body game_context i (j+1)
                draw_cell life_body game_context i j
        else return ()
             
    draw_cell life_body game_context i j = do
      let cell_width = (getScreenHeight game_context) `div` life_body_board_width
          x = j * cell_width
          y = i * cell_width
          rect_back = Rect x y cell_width cell_width
          rect = Rect x y (cell_width-1) (cell_width-1)
          screen = getSurface game_context
          pixel_format = SDL.surfaceGetPixelFormat screen

      color_back <- SDL.mapRGB pixel_format 0 0 0
      SDL.fillRect screen (Just rect_back) color_back
      
      if life_body !! i !! j == 0 
        then do color <- SDL.mapRGB pixel_format 255 0 0
                SDL.fillRect screen (Just rect) color
                return ()
        else do color <- SDL.mapRGB pixel_format 0 255 0
                SDL.fillRect screen (Just rect) color
                return ()
                
data GameState = GameRunning | GameOver
             
event_handler = do             
  e <- SDL.pollEvent
  case e of
    KeyUp (Keysym SDLK_q _ _) 
      -> return GameOver
    Quit     
      -> return GameOver
    otherwise 
      -> return GameRunning

main_loop life_body game_context ctick = do
  v <- event_handler
  case v of
    GameRunning -> do
      tick <- getTicks 
      
      if tick - ctick > 100
        then do print_life_body life_body
                draw_game_board life_body game_context
                main_loop (update_life_body life_body) game_context tick
        else do SDL.delay 1
                main_loop life_body game_context ctick
             
    otherwise ->
      return ()
				
main = do
  SDL.init [InitEverything]
  SDL.setVideoMode 640 480 32 []
  screen <- SDL.getVideoSurface
  SDL.flip screen
  main_loop init_life_body (GameContext screen 648 480) 0

